home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / winfo.test < prev    next >
Encoding:
Text File  |  1995-06-15  |  9.2 KB  |  259 lines
  1. # This file is a Tcl script to test out the "winfo" command.  It is
  2. # organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1994 The Regents of the University of California.
  5. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10. # @(#) winfo.test 1.9 95/04/23 14:49:54
  11.  
  12. if {[info procs test] != "test"} {
  13.     source defs
  14. }
  15.  
  16. foreach i [winfo children .] {
  17.     destroy $i
  18. }
  19. wm geometry . {}
  20. raise .
  21.  
  22. # eatColors --
  23. # Creates a toplevel window and allocates enough colors in it to
  24. # use up all the slots in the colormap.
  25. #
  26. # Arguments:
  27. # w -        Name of toplevel window to create.
  28. # options -    Options for w, such as "-colormap new".
  29.  
  30. proc eatColors {w {options ""}} {
  31.     catch {destroy $w}
  32.     eval toplevel $w $options
  33.     wm geom $w +0+0
  34.     canvas $w.c -width 400 -height 200 -bd 0
  35.     pack $w.c
  36.     for {set y 0} {$y < 8} {incr y} {
  37.     for {set x 0} {$x < 40} {incr x} {
  38.         set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
  39.         $w.c create rectangle [expr 10*$x] [expr 20*$y] \
  40.             [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
  41.             -fill $color
  42.     }
  43.     }
  44.     update
  45. }
  46.  
  47. # XXX - This test file is woefully incomplete.  At present, only a
  48. # few of the winfo options are tested.
  49.  
  50. test winfo-1.1 {"winfo atom" command} {
  51.     list [catch {winfo atom} msg] $msg
  52. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  53. test winfo-1.2 {"winfo atom" command} {
  54.     list [catch {winfo atom a b} msg] $msg
  55. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  56. test winfo-1.3 {"winfo atom" command} {
  57.     list [catch {winfo atom a b c d} msg] $msg
  58. } {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
  59. test winfo-1.4 {"winfo atom" command} {
  60.     list [catch {winfo atom -displayof geek foo} msg] $msg
  61. } {1 {bad window path name "geek"}}
  62. test winfo-1.5 {"winfo atom" command} {
  63.     winfo atom PRIMARY
  64. } 1
  65. test winfo-1.6 {"winfo atom" command} {
  66.     winfo atom -displayof . PRIMARY
  67. } 1
  68.  
  69. test winfo-2.1 {"winfo atomname" command} {
  70.     list [catch {winfo atomname} msg] $msg
  71. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  72. test winfo-2.2 {"winfo atomname" command} {
  73.     list [catch {winfo atomname a b} msg] $msg
  74. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  75. test winfo-2.3 {"winfo atomname" command} {
  76.     list [catch {winfo atomname a b c d} msg] $msg
  77. } {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
  78. test winfo-2.4 {"winfo atomname" command} {
  79.     list [catch {winfo atomname -displayof geek foo} msg] $msg
  80. } {1 {bad window path name "geek"}}
  81. test winfo-2.5 {"winfo atomname" command} {
  82.     list [catch {winfo atomname 44215} msg] $msg
  83. } {1 {no atom exists with id "44215"}}
  84. test winfo-2.6 {"winfo atomname" command} {
  85.     winfo atomname 2
  86. } SECONDARY
  87. test winfo-2.7 {"winfo atom" command} {
  88.     winfo atomname -displayof . 2
  89. } SECONDARY
  90.  
  91. if {([winfo depth .] == 8) && ([winfo visual .] == "pseudocolor")} {
  92.     test winfo-2.1 {"winfo colormapfull" command} {
  93.     list [catch {winfo colormapfull} msg] $msg
  94.     } {1 {wrong # arguments: must be "winfo colormapfull window"}}
  95.     test winfo-2.2 {"winfo colormapfull" command} {
  96.     list [catch {winfo colormapfull a b} msg] $msg
  97.     } {1 {wrong # arguments: must be "winfo colormapfull window"}}
  98.     test winfo-2.3 {"winfo colormapfull" command} {
  99.     list [catch {winfo colormapfull foo} msg] $msg
  100.     } {1 {bad window path name "foo"}}
  101.     test winfo-2.4 {"winfo colormapfull" command} {
  102.     eatColors .t {-colormap new}
  103.     set result [list [winfo colormapfull .] [winfo colormapfull .t]]
  104.     .t.c delete 34
  105.     lappend result [winfo colormapfull .t]
  106.     .t.c create rectangle 30 30 80 80 -fill #441739
  107.     lappend result [winfo colormapfull .t]
  108.     .t.c create rectangle 40 40 90 90 -fill #ffeedd
  109.     lappend result [winfo colormapfull .t]
  110.     destroy .t.c
  111.     lappend result [winfo colormapfull .t]
  112.     } {0 1 0 0 1 0}
  113.     catch {destroy .t}
  114. }
  115.  
  116. catch {destroy .t}
  117. toplevel .t -width 550 -height 400
  118. frame .t.f -width 80 -height 60 -bd 2 -relief raised
  119. place .t.f -x 50 -y 50
  120. wm geom .t +0+0
  121. update
  122. test winfo-3.1 {"winfo containing" command} {
  123.     list [catch {winfo containing 22} msg] $msg
  124. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  125. test winfo-3.2 {"winfo containing" command} {
  126.     list [catch {winfo containing a b c} msg] $msg
  127. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  128. test winfo-3.3 {"winfo containing" command} {
  129.     list [catch {winfo containing a b c d e} msg] $msg
  130. } {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
  131. test winfo-3.4 {"winfo containing" command} {
  132.     list [catch {winfo containing -displayof geek 25 30} msg] $msg
  133. } {1 {bad window path name "geek"}}
  134. test winfo-3.5 {"winfo containing" command} {
  135.     winfo containing [winfo rootx .t.f] [winfo rooty .t.f]
  136. } .t.f
  137. test winfo-3.6 {"winfo containing" command} {
  138.     winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1]
  139. } .t
  140. test winfo-3.7 {"winfo containing" command} {
  141.     set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \
  142.         [expr [winfo rooty .t.f]+450]]
  143.     expr {($x == ".") || ($x == "")}
  144. } {1}
  145. destroy .t
  146.  
  147. test winfo-4.1 {"winfo interps" command} {
  148.     list [catch {winfo interps a} msg] $msg
  149. } {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
  150. test winfo-4.2 {"winfo interps" command} {
  151.     list [catch {winfo interps a b c} msg] $msg
  152. } {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
  153. test winfo-4.3 {"winfo interps" command} {
  154.     list [catch {winfo interps -displayof geek} msg] $msg
  155. } {1 {bad window path name "geek"}}
  156. test winfo-4.4 {"winfo interps" command} {
  157.     expr [lsearch -exact [winfo interps] [tk appname]] >= 0
  158. } {1}
  159. test winfo-4.5 {"winfo interps" command} {
  160.     expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0
  161. } {1}
  162.  
  163. test winfo-5.1 {"winfo exists" command} {
  164.     list [catch {winfo exists} msg] $msg
  165. } {1 {wrong # arguments: must be "winfo exists window"}}
  166. test winfo-5.2 {"winfo exists" command} {
  167.     list [catch {winfo exists a b} msg] $msg
  168. } {1 {wrong # arguments: must be "winfo exists window"}}
  169. test winfo-5.3 {"winfo exists" command} {
  170.     winfo exists gorp
  171. } {0}
  172. test winfo-5.4 {"winfo exists" command} {
  173.     winfo exists .
  174. } {1}
  175. test winfo-5.5 {"winfo exists" command} {
  176.     button .b -text "Test button"
  177.     set x [winfo exists .b]
  178.     pack .b
  179.     update
  180.     bind .b <Destroy> {lappend x [winfo exists .x]}
  181.     destroy .b
  182.     lappend x [winfo exists .x]
  183. } {1 0 0}
  184.  
  185. catch {destroy .b}
  186. button .b -text "Help"
  187. update
  188. test winfo-6.1 {"winfo pathname" command} {
  189.     list [catch {winfo pathname} msg] $msg
  190. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  191. test winfo-6.2 {"winfo pathname" command} {
  192.     list [catch {winfo pathname a b} msg] $msg
  193. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  194. test winfo-6.3 {"winfo pathname" command} {
  195.     list [catch {winfo pathname a b c d} msg] $msg
  196. } {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
  197. test winfo-6.4 {"winfo pathname" command} {
  198.     list [catch {winfo pathname -displayof geek 25} msg] $msg
  199. } {1 {bad window path name "geek"}}
  200. test winfo-6.5 {"winfo pathname" command} {
  201.     list [catch {winfo pathname xyz} msg] $msg
  202. } {1 {expected integer but got "xyz"}}
  203. test winfo-6.6 {"winfo pathname" command} {
  204.     list [catch {winfo pathname 224} msg] $msg
  205. } {1 {window id "224" doesn't exist in this application}}
  206. test winfo-6.7 {"winfo pathname" command} {
  207.     winfo pathname -displayof .b [winfo id .]
  208. } {.}
  209.  
  210. test winfo-7.1 {"winfo viewable" command} {
  211.     list [catch {winfo viewable} msg] $msg
  212. } {1 {wrong # arguments: must be "winfo viewable window"}}
  213. test winfo-7.2 {"winfo viewable" command} {
  214.     list [catch {winfo viewable foo} msg] $msg
  215. } {1 {bad window path name "foo"}}
  216. test winfo-7.3 {"winfo viewable" command} {
  217.     winfo viewable .
  218. } {1}
  219. test winfo-7.4 {"winfo viewable" command} {
  220.     wm iconify .
  221.     winfo viewable .
  222. } {0}
  223. wm deiconify .
  224. test winfo-7.5 {"winfo viewable" command} {
  225.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  226.     place .f1 -x 0 -y 0
  227.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  228.     place .f1.f2 -x 0 -y 0
  229.     update
  230.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  231. } {1 1}
  232. test winfo-7.6 {"winfo viewable" command} {
  233.     eval destroy [winfo child .]
  234.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  235.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  236.     place .f1.f2 -x 0 -y 0
  237.     update
  238.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  239. } {0 0}
  240. test winfo-7.7 {"winfo viewable" command} {
  241.     eval destroy [winfo child .]
  242.     frame .f1 -width 100 -height 100 -relief raised -bd 2
  243.     place .f1 -x 0 -y 0
  244.     frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
  245.     place .f1.f2 -x 0 -y 0
  246.     update
  247.     wm iconify .
  248.     list [winfo viewable .f1] [winfo viewable .f1.f2]
  249. } {0 0}
  250. wm deiconify .
  251. eval destroy [winfo child .]
  252.  
  253. test winfo-8.1 {GetDisplayOf procedure} {
  254.     list [catch {winfo atom - foo x} msg] $msg
  255. } {1 {bad argument "-": must be -displayof}}
  256. test winfo-8.2 {GetDisplayOf procedure} {
  257.     list [catch {winfo atom -d bad_window x} msg] $msg
  258. } {1 {bad window path name "bad_window"}}
  259.